home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / HTML / TreeBuilder.pm < prev   
Encoding:
Perl POD Document  |  1999-12-28  |  7.9 KB  |  317 lines
  1. package HTML::TreeBuilder;
  2.  
  3. =head1 NAME
  4.  
  5. HTML::TreeBuilder - Parser that builds a HTML syntax tree
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.  $h = new HTML::TreeBuilder;
  10.  $h->parse($document);
  11.  
  12.  print $h->as_HTML;  # or any other HTML::Element method
  13.  
  14. =head1 DESCRIPTION
  15.  
  16. This is a parser that builds (and actually itself is) a HTML syntax tree.
  17.  
  18. Objects of this class inherit the methods of both C<HTML::Parser> and
  19. C<HTML::Element>.  After parsing has taken place it can be regarded as
  20. the syntax tree itself.
  21.  
  22. The following method all control how parsing takes place.  You can set
  23. the attributes by passing a TRUE or FALSE value as argument.
  24.  
  25. =over 4
  26.  
  27. =item $p->implicit_tags
  28.  
  29. Setting this attribute to true will instruct the parser to try to
  30. deduce implicit elements and implicit end tags.  If it is false you
  31. get a parse tree that just reflects the text as it stands.  Might be
  32. useful for quick & dirty parsing.  Default is true.
  33.  
  34. Implicit elements have the implicit() attribute set.
  35.  
  36. =item $p->ignore_unknown
  37.  
  38. This attribute controls whether unknown tags should be represented as
  39. elements in the parse tree.  Default is true.
  40.  
  41. =item $p->ignore_text
  42.  
  43. Do not represent the text content of elements.  This saves space if
  44. all you want is to examine the structure of the document.  Default is
  45. false.
  46.  
  47. =item $p->warn
  48.  
  49. Call warn() with an appropriate message for syntax errors.  Default is
  50. false.
  51.  
  52. =back
  53.  
  54.  
  55. =head1 SEE ALSO
  56.  
  57. L<HTML::Parser>, L<HTML::Element>
  58.  
  59. =head1 COPYRIGHT
  60.  
  61. Copyright 1995-1996 Gisle Aas. All rights reserved.
  62.  
  63. This library is free software; you can redistribute it and/or
  64. modify it under the same terms as Perl itself.
  65.  
  66. =head1 AUTHOR
  67.  
  68. Gisle Aas <aas@sn.no>
  69.  
  70. =cut
  71.  
  72. use HTML::Entities ();
  73.  
  74. use strict;
  75. use vars qw(@ISA
  76.             %isHeadElement %isBodyElement %isPhraseMarkup
  77.             %isList %isTableElement %isFormElement
  78.            );
  79.  
  80. require HTML::Element;
  81. require HTML::Parser;
  82. @ISA = qw(HTML::Element HTML::Parser);
  83.  
  84. %isHeadElement = map { $_ => 1 } qw(title base link meta isindex script);
  85.  
  86. %isBodyElement = map { $_ => 1 } qw(h1 h2 h3 h4 h5 h6
  87.                     p div pre address blockquote
  88.                     xmp listing
  89.                     a img br hr
  90.                     ol ul dir menu li
  91.                     dl dt dd
  92.                     cite code em kbd samp strong var dfn strike
  93.                     b i u tt small big
  94.                     table tr td th caption
  95.                     form input select option textarea
  96.                     map area
  97.                     applet param
  98.                     isindex script
  99.                    ),
  100.                                  qw(wbr nobr center blink font basefont);
  101.  
  102.  
  103. %isPhraseMarkup = map { $_ => 1 } qw(cite code em kbd samp strong var b i u tt
  104.                      a img br hr
  105.                      wbr nobr center blink
  106.                      small big font basefont
  107.                      table
  108.                     );
  109.  
  110. %isList         = map { $_ => 1 } qw(ul ol dir menu);
  111. %isTableElement = map { $_ => 1 } qw(tr td th caption);
  112. %isFormElement  = map { $_ => 1 } qw(input select option textarea);
  113.  
  114.  
  115. sub new
  116. {
  117.     my $class = shift;
  118.     my $self = HTML::Element->new('html');  # Initialize HTML::Element part
  119.     $self->{'_buf'} = '';  # The HTML::Parser part of us needs this
  120.  
  121.     $self->{'_implicit_tags'}  = 1;
  122.     $self->{'_ignore_unknown'} = 1;
  123.     $self->{'_ignore_text'}    = 0;
  124.     $self->{'_warn'}           = 0;
  125.  
  126.     my %attr = @_;
  127.     for (keys %attr) {
  128.     $self->{"_$_"} = $attr{$_};
  129.     }
  130.  
  131.     bless $self, $class; 
  132. }
  133.  
  134. sub _elem
  135. {
  136.     my($self, $elem, $val) = @_;
  137.     my $old = $self->{$elem};
  138.     $self->{$elem} = $val if defined $val;
  139.     return $old;
  140. }
  141.  
  142. sub implicit_tags  { shift->_elem('_implicit_tags',  @_); }
  143. sub ignore_unknown { shift->_elem('_ignore_unknown', @_); }
  144. sub ignore_text    { shift->_elem('_ignore_text',    @_); }
  145. sub warn           { shift->_elem('_warn',           @_); }
  146.  
  147. sub warning
  148. {
  149.     my $self = shift;
  150.     warn "HTML::Parse: $_[0]\n" if $self->{'_warn'};
  151. }
  152.  
  153. sub start
  154. {
  155.     my($self, $tag, $attr) = @_;
  156.  
  157.     my $pos  = $self->{'_pos'};
  158.     $pos = $self unless defined $pos;
  159.     my $ptag = $pos->{'_tag'};
  160.     my $e = HTML::Element->new($tag, %$attr);
  161.  
  162.     if (!$self->{'_implicit_tags'}) {
  163.     } elsif ($isBodyElement{$tag}) {
  164.  
  165.     if ($pos->is_inside('head')) {
  166.         $self->end('head');
  167.         $pos = $self->insert_element('body', 1);
  168.         $ptag = $pos->tag;
  169.     } elsif (!$pos->is_inside('body')) {
  170.         $pos = $self->insert_element('body', 1);
  171.         $ptag = $pos->tag;
  172.     }
  173.  
  174.     if ($tag eq 'p' || $tag =~ /^h[1-6]/ || $tag eq 'form') {
  175.         $self->end([qw(p h1 h2 h3 h4 h5 h6 pre textarea)], 'li');
  176.     } elsif ($tag =~ /^[oud]l$/) {
  177.         if ($ptag =~ /^h[1-6]/) {
  178.         $self->end($ptag);
  179.         $pos = $self->insert_element('p', 1);
  180.         $ptag = 'p';
  181.         }
  182.     } elsif ($tag eq 'li') {
  183.         $self->end('li', keys %isList);
  184.         $ptag = $self->pos->tag;
  185.         $pos = $self->insert_element('ul', 1) unless $isList{$ptag};
  186.     } elsif ($tag eq 'dt' || $tag eq 'dd') {
  187.         $self->end(['dt', 'dd'], 'dl');
  188.         $ptag = $self->pos->tag;
  189.         $pos = $self->insert_element('dl', 1) unless $ptag eq 'dl';
  190.     } elsif ($isFormElement{$tag}) {
  191.         return unless $pos->is_inside('form');
  192.         if ($tag eq 'option') {
  193.         $self->end('option');
  194.         $ptag = $self->pos->tag;
  195.         $pos = $self->insert_element('select', 1)
  196.           unless $ptag eq 'select';
  197.         }
  198.     } elsif ($isTableElement{$tag}) {
  199.         $self->end($tag, 'table');
  200.         $pos = $self->insert_element('table', 1)
  201.           if !$pos->is_inside('table');
  202.     } elsif ($isPhraseMarkup{$tag}) {
  203.         if ($ptag eq 'body') {
  204.         $pos = $self->insert_element('p', 1);
  205.         }
  206.     }
  207.     } elsif ($isHeadElement{$tag}) {
  208.     if ($pos->is_inside('body')) {
  209.         $self->warning("Header element <$tag> in body");
  210.     } elsif (!$pos->is_inside('head')) {
  211.         $pos = $self->insert_element('head', 1);
  212.     }
  213.     } elsif ($tag eq 'html') {
  214.     if ($ptag eq 'html' && $pos->is_empty()) {
  215.         for (keys %$attr) {
  216.         $self->attr($_, $attr->{$_});
  217.         }
  218.         return;
  219.     } else {
  220.         $self->warning("Skipping nested <html> element");
  221.         return;
  222.     }
  223.     } elsif ($tag eq 'head') {
  224.     if ($ptag ne 'html' && $pos->is_empty()) {
  225.         $self->warning("Skipping nested <head> element");
  226.         return;
  227.     }
  228.     } elsif ($tag eq 'body') {
  229.     if ($pos->is_inside('head')) {
  230.         $self->end('head');
  231.     } elsif ($ptag ne 'html') {
  232.         $self->warning("Skipping nested <body> element");
  233.         return;
  234.     }
  235.     } else {
  236.     if ($self->{'_ignore_unknown'}) {
  237.         $self->warning("Skipping unknown tag $tag");
  238.         return;
  239.     }
  240.     }
  241.     $self->insert_element($e);
  242. }
  243.  
  244.  
  245. sub end
  246. {
  247.     my($self, $tag, @stop) = @_;
  248.  
  249.  
  250.     my $p = $self->{'_pos'};
  251.     $p = $self unless defined($p);
  252.     if (ref $tag) {
  253.       PARENT:
  254.     while (defined $p) {
  255.         my $ptag = $p->{'_tag'};
  256.         for (@$tag) {
  257.         last PARENT if $ptag eq $_;
  258.         }
  259.         for (@stop) {
  260.         return if $ptag eq $_;
  261.         }
  262.         $p = $p->{'_parent'};
  263.     }
  264.     } else {
  265.     while (defined $p) {
  266.         my $ptag = $p->{'_tag'};
  267.         last if $ptag eq $tag;
  268.         for (@stop) {
  269.         return if $ptag eq $_;
  270.         }
  271.         $p = $p->{'_parent'};
  272.     }
  273.     }
  274.  
  275.     $self->{'_pos'} = $p->{'_parent'} if defined $p;
  276. }
  277.  
  278.  
  279. sub text
  280. {
  281.     my $self = shift;
  282.     my $pos = $self->{'_pos'};
  283.     my $ignore_text = $self->{'_ignore_text'};
  284.  
  285.     $pos = $self unless defined($pos);
  286.  
  287.     my $text = shift;
  288.     return unless length $text;
  289.  
  290.     HTML::Entities::decode($text) unless $ignore_text;
  291.  
  292.     if ($pos->is_inside(qw(script pre xmp listing))) {
  293.     return if $ignore_text;
  294.     $pos->push_content($text);
  295.     } else {
  296.  
  297.     my $ptag = $pos->{'_tag'};
  298.     if (!$self->{'_implicit_tags'} || $text !~ /\S/) {
  299.     } elsif ($ptag eq 'head') {
  300.         $self->end('head');
  301.         $self->insert_element('body', 1);
  302.         $pos = $self->insert_element('p', 1);
  303.     } elsif ($ptag eq 'html') {
  304.         $self->insert_element('body', 1);
  305.         $pos = $self->insert_element('p', 1);
  306.     } elsif ($ptag eq 'body' ||
  307.          $ptag eq 'form') {
  308.         $pos = $self->insert_element('p', 1);
  309.     }
  310.     return if $ignore_text;
  311.     $text =~ s/\s+/ /g;  # canoncial space
  312.     $pos->push_content($text);
  313.     }
  314. }
  315.  
  316. 1;
  317.